home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-04 / bipl.zip / PROGS.ZIP / SNAKE.ICN < prev    next >
Text File  |  1992-09-28  |  6KB  |  240 lines
  1. ############################################################################
  2. #
  3. #    File:     snake.icn
  4. #
  5. #    Subject:  Program to play the snake game
  6. #
  7. #    Author:   Richard L. Goerwitz
  8. #
  9. #    Date:     December 30, 1991
  10. #
  11. ###########################################################################
  12. #
  13. #    Version:  1.9
  14. #
  15. ###########################################################################
  16. #  
  17. #      While away the idle moments watching the snake eat blank squares
  18. #  on your screen.  Snake has only one (optional) argument -
  19. #
  20. #      usage:  snake [character]
  21. #
  22. #  where "character" represents a single character to be used in drawing
  23. #  the snake.  The default is an "o."  In order to run snake, your ter-
  24. #  minal must have cursor movement capability, and must be able to do re-
  25. #  verse video.
  26. #
  27. #      I wrote this program to test itlib.icn, iscreen.icn, and some
  28. #  miscellaneous utilities I wrote.  It clears the screen, moves the cur-
  29. #  sor to arbitrary squares on the screen, changes video mode, and in
  30. #  general exercizes the terminal capability database on the target ma-
  31. #  chine.
  32. #
  33. ############################################################################
  34. #
  35. #  Bugs:  Most magic cookie terminals just won't work.  Terminal really
  36. #  needs reverse video (it will work without, but won't look as cute).
  37. #
  38. ############################################################################
  39. #
  40. #  Links: itlib.icn (or iolib.icn), iscreen.icn
  41. #
  42. #  Requires:  UNIX (MS-DOS is okay, if you replace itlib with itlibdos.icn)
  43. #
  44. ############################################################################
  45.  
  46. link itlib, iscreen
  47.  
  48. global max_l, max_w, snake_char
  49.  
  50. record wholething(poop,body)
  51.  
  52. procedure main(a)
  53.  
  54.     local snake, limit, sl, sw, CM, x, r, leftbehind
  55.  
  56.     &clock ? { while tab(find(":")+1); &random := integer(tab(0)) }
  57.     if not (getval("so"),  CM := getval("cm"))
  58.     then stop("snake:  Your terminal is too stupid to run me.  Sorry.")
  59.     clear(); Kludge() # if your term likes it, use emphasize(); clear()
  60.     # Decide how much space we have to operate in.
  61.     max_l := getval("li")-2             # global
  62.     max_w := getval("co")-1             # global
  63.     # Determine the character that will be used to represent the snake.
  64.     snake_char := (\a[1])[1] | "o"
  65.  
  66.     # Make the head.
  67.     snake := []; put(snake,[?(max_l-1)+1, ?(max_w-1)+1])
  68.     # Make the body, displaying it as it grows.
  69.     every x := 2 to 25 do {
  70.     display(,snake)
  71.     put(snake,findnext(snake[x-1],snake))
  72.     }
  73.  
  74.     # Begin "eating" all the standout mode spaces on the screen.
  75.     repeat {
  76.     r := makenew(snake)
  77.     leftbehind := r.poop
  78.     snake := r.body
  79.     display(leftbehind,snake) | break
  80.     }
  81.  
  82.     # Shrink the snake down to nothing, displaying successively smaller bits.
  83.     while leftbehind := get(snake)
  84.     do display(leftbehind,snake)
  85.  
  86.     iputs(igoto(getval("cm"), 1, getval("li")-1))
  87.     normal()
  88.     
  89. end 
  90.  
  91.  
  92.  
  93. procedure findnext(L, snake)
  94.  
  95.     local i, j, k, op, l
  96.     static sub_lists
  97.     initial {
  98.     sub_lists := [[1,2,3], [1,3,2], [3,2,1], [3,1,2], [2,1,3], [2,3,1]]
  99.     }
  100.     # global max_l, max_w
  101.  
  102.     i := L[1]; j := L[2]    # for clarity, use i, j (not l[i|j])
  103.  
  104.     # L is the last snake segment; find k and l, such that k and l are
  105.     # valid line and column numbers differing from l[1] and l[2] by no
  106.     # more than 1, respectively.  Put simply:  Create a new segment
  107.     # [k, l] adjacent to the last one (L).
  108.  
  109.     op := (different | Null) &
  110.     (k := max_l+1 > [i,i+1,i-1][!sub_lists[?6]]) > 1 &
  111.     (l := max_w+1 > [j,j+1,j-1][!sub_lists[?6]]) > 1 &
  112.     op([k, l], snake)
  113.  
  114.     return [k, l]
  115.  
  116. end
  117.  
  118.  
  119.  
  120. procedure different(l,snake)
  121.  
  122.     local bit
  123.     (l[1] = (bit := !\snake)[1], l[2] = bit[2]) & fail
  124.     return
  125.  
  126. end
  127.  
  128.  
  129.  
  130. procedure Null(a[])
  131.     return
  132. end
  133.  
  134.  
  135.  
  136. procedure display(lb,snake)
  137.  
  138.     local last_segment, character
  139.     static CM
  140.     initial CM := getval("cm")
  141.  
  142.     # Change the mode of the square just "vacated" by the moving snake.
  143.     if *snake = 0 | different(\lb,snake) then {
  144.     iputs(igoto(CM, lb[2], lb[1]))
  145.     normal()
  146.     writes(" ")
  147.     }
  148.  
  149.     if last_segment := (0 ~= *snake) then {
  150.     # Write the last segment (which turns out to be the snakes head!).
  151.     iputs(igoto(CM, snake[last_segment][2], snake[last_segment][1]))
  152.     emphasize(); writes(snake_char)  # snake_char is global
  153.     }
  154.  
  155.     # Check to see whether we've eaten every edible square on the screen.
  156.     if done_yet(lb)
  157.     then fail
  158.     else return
  159.  
  160. end
  161.  
  162.  
  163.  
  164. procedure makenew(snake)
  165.     local leftbehind, i
  166.  
  167.     # Move each constituent list up one position in snake, discard
  168.     # the first element, and tack a new one onto the end.
  169.  
  170.     every i := 1 to *snake - 1 do
  171.     snake[i] :=: snake[i+1]
  172.     leftbehind := copy(snake[i+1])
  173.     snake[i+1] := findnext(snake[i],snake)
  174.     return wholething(leftbehind,snake)
  175.     
  176. end
  177.  
  178.  
  179.  
  180. procedure the_same(l1, l2)
  181.  
  182.     if l1[1] = l2[1] & l1[2] = l2[2]
  183.     then return else fail
  184.  
  185. end
  186.  
  187.  
  188.  
  189. procedure done_yet(l)
  190.     local i, j
  191.  
  192.     # Check to see if we've eaten every edible square on the screen.
  193.     # It's easy for snake to screw up on this one, since somewhere
  194.     # along the line most terminal/driver/line combinations will con-
  195.     # spire to drop a character somewhere along the line.
  196.  
  197.     static square_set
  198.     initial {
  199.  
  200.     square_set := set()
  201.     every i := 2 to max_l do {
  202.         every j := 2 to max_w do {
  203.         insert(square_set, i*j)
  204.         }
  205.     }
  206.     }
  207.  
  208.     /l & fail
  209.     delete(square_set, l[1]*l[2])
  210.     if *square_set = 0 then return
  211.     else fail
  212.  
  213. end
  214.  
  215.  
  216.  
  217. procedure Kludge()
  218.     local i
  219.  
  220.     # Horrible way of clearing the screen to all reverse-video, but
  221.     # the only apparent way we can do it "portably" using the termcap
  222.     # capability database.
  223.  
  224.     iputs(igoto(getval("cm"),1,1))
  225.     if getval("am") then {
  226.     emphasize()
  227.         every 1 to (getval("li")-1) * getval("co") do
  228.         writes(" ")
  229.     }
  230.     else {
  231.     every i := 1 to getval("li")-1 do {
  232.         iputs(igoto(getval("cm"), 1, i))
  233.         emphasize()
  234.         writes(repl(" ",getval("co")))
  235.     }
  236.     }
  237.     iputs(igoto(getval("cm"),1,1))
  238.  
  239. end
  240.